perm filename FAIL[MSS,LCS] blob sn#179209 filedate 1975-09-28 generic text, type T, neo UTF8
13000	DBAR:	0	; CALL DBAR(K,ITEM,J)
14100		MOVE 4,@2(16)	; -J-RR=RN(J+3)
14150		MOVE 7,XRN+2(4)		; -RR-
14200		MOVE 4,@(16)	;	DO 82 KY=K+1,ITEM
14300	DB:	MOVE 5,PTR(4)	;KZ=PWDS(KY)
14350		FIXX(5)		; -KY-
14400		MOVE 6,XRN(5)	;	IF(RN(KZ+1).NE.4)GO TO 82
14450		CAME 6,[4.0]
14460		JRST DB82
14500		MOVE 6,XRN-1(5)	;IF(RN(KZ).NE.2)GO TO 82
14510		CAME 6,[2.0]
14520		JRST DB82
14600	;;C  AVOIDS DUPLICATE BARS.
14700		MOVN 6,XRN+2(5)  ;IF(ABS(RR-RN(KZ+3)).GT..5)GO TO 82	
14710		FADR 6,7
14720		SKIPGE 6
14730		MOVNS 6
14740		CAMLE 6,[0.5]
14750		JRST DB82
14800		MOVE 6,[99.0]  ;RN(KZ+2)=99
14810		MOVE 6,XRN+1(5)
14900		SETZM XRN(5)	;RN(KZ+1)=0
15000	DB82:	AOJ 4,  ;82	CONTINUE
15010		CAME 4,@1(16)
15020		JRST DB
15030		JRA 16,3(16)
15040	
15100		IF(YN.NE.'Y')GO TO 810
15200		CALL ADDRST(RR,XWDS,PN)
15300		GO TO 6
15400	182	RN(J+1)=44
15500	C  CHANGES CODE NUM 
15600		IF(RN(J).LT.5)GO TO 80
15700		IF(RN(J+7).GE.3)GO TO 6
15800	C  SKIP HEAVY BRACKETS.
15900	80	RSN=RN(J+2)
16000	C  THE STAFF NUM.
16100	CC80	IF(RN(J+2).NE.SN)GO TO 6
16200		IF(R.NE.3)GO TO 3801
16300		IF(YCLEF)GO TO 4801
16400		IF(RSN.NE.SN)GO TO 6
16500	4801	RR=RN(J+5)
16600		IF(RN(J).LT.3)RR=0
16700		IF(RR.EQ.CLEF)GO TO 6
16800	C SKIP DUPLICATE CLEFS.
16900		IF(RR.GT.3)GO TO 4800
17000		CLEF=RR
17100	C**	IF(YCLEF.EQ.1)GO TO 4802
17200	C**	IF(YCLEF)YCLEF=1.
17300		YCLEF=0
17400		GO TO 1800
17500	4800	IF(RSN.NE.SN)GO TO 6
17600		RN(J+1)=33
17700		GO TO 1800
17800	4802	YCLEF=0
17900	C  CATCHES CLEF AFTER FIRST RESTS.
18000		GO TO 6
18100	3801	IF(R.NE.17)GO TO 3800
18200		IF(YSIG)GO TO 3802
18300		IF(RSN.NE.SN)GO TO 6
18400	3802	IF(RN(J+5).EQ.XSIG)GO TO 6
18500		YSIG=0
18600		XSIG=RN(J+5)
18700	C SKIPS DUPL. KEY SIGS.
18800		GO TO 1800
18900	3800	IF(R.EQ.8)GO TO 6
19000	C  OMIT ALL STAVES FOR NOW
19100		IF(R.NE.18.)GO TO 81
19200		IF(YMTR)GO TO 1801
19300		IF(RSN.NE.SN)GO TO 6
19400	1801	RA=RN(J+5)*100.+RN(J+6)
19500	C  THE TIME SIG.
19600		IF(XMTR.EQ.RA)GO TO 6
19700		XMTR=RA
19800		YMTR=0
19900		GO TO 1800
20000	81	IF(RSN.NE.SN)GO TO 6
20100	1800	IF(RN(J+3).LT.XLFT)GO TO 6
20200	C OMIT SOME THINGS TO LEFT OF STAFF BEGINNING.
20300	810	JA=PWDS(K+1)
20400		RN(J+2)=RS
20500		DO 7 KY=J,JA-1
20600		PN(LK)=RN(KY)
20700	7	LK=LK+1
20800		L=L+1
20900		XWDS(L)=LK
21000	6	CONTINUE
21100	
21200	C******↓↓↓↓↓↓ RHYTH RESET ↓↓↓↓↓↓↓↓
21300		I=1
21400		DO 243 K=1,L-1
21500		LB=XWDS(K)+1
21600		IF(PN(LB).NE.16)GO TO 243
21700		IF(PN(LB-1).LT.8)GO TO 243
21800		JL=XWDS(K-1)
21900	244	PN(LB+2)=PN(JL+3)
22000	C PUTS CONTINUATION OF TEXT IMMEDIATELY AFTER PREV. POS.
22100	C  FOR SPACING PROBLEMS BELOW.
22200	243	CONTINUE
22300		M=2
22400		J=1
22500	24	RA=100000.
22600	C  POSITION
22700		DO 21 K=1,L-1
22800		JL=XWDS(K)+3
22900		R=PN(JL)
23000		IF(R.EQ.100000)GO TO 21
23100	241	IF(ABS(R-RA).GT..1)GO TO 240
23200		R=RA
23300		PN(JL)=R
23400	C  PUT IN HERE MULTI-VOICE TRAP
23500		GO TO 21
23600	240	IF(R.GT.RA)GO TO 21
23700	C  LINES THEM UP
23800		I=K
23900		RA=R
24000	21	CONTINUE
24100		IF(RA.EQ.100000)GO TO 23
24200	C  JUMP IF ALL SORTED
24300	242	JL=XWDS(I)
24400		LA=JL
24500		N=PN(JL)+3
24600	C  NEXT POINTER
24700		PWDS(M)=PWDS(M-1)+N
24800		M=M+1
24900		DO 22 K=J,J+N-1
25000		RN(K)=PN(JL)
25100	22	JL=JL+1
25200		PN(LA+3)=100000
25300	C  PUT IT ASIDE
25400		J=N+J
25500		GO TO 24
25600	
25700	23	IF(ENDLN.EQ.0)GO TO 2334
25800		R4=0
25900		R5=1000
26000		R7=RS
26100		R8=ENDLN
26200		R9=0
26300		GO TO 33
26400	2334	R4=0
26500		R5=10000
26600	CC	R8=-XLFT
26700		R8=1.-RN(4)
26800		R9=0
26900	C  INSERT??  →→ IF(R8.GT.0)R9=200.
27000		R7=RS
27100	33	CALL PTMOVE(RN,PWDS)
27200		DO 32 K=1,IFIX(PWDS(L))-1
27300		KQ=KQ+1
27400	32	Q(KQ)=RN(K)
27500		ENDLN=ENDLN+200
27600		L=1
27700		LK=1
27800		TYPE 3001,KQ
27900		GO TO 10
28000	
28100	27	FORMAT(' RESPACING')
28200	20	K=1
28300		TYPE 27
28400		KK=1
28500	220	JJ=Q(K)+3
28600		PN(KK)=K
28700	C NEW POINTER
28800		K=K+JJ
28900		KK=KK+1
29000		IF(K.LT.KQ)GO TO 220
29100		PN(KK)=K
29200		TYPE 3001,KK
29300		L=KK
29400	C  DELETES EXTRA BAR LINES, ETC.
29500		CALL RESTS(PN,Q)
29600	C  FROM NOW ON ALL CODES #-1 ARE IGNORED, RESTS HAVE BEEN COMBINED.
29700		K=1
29800		L=1
29900		LL=0
30000		LK=1
30100	221	IF(Q(IFIX(PN(K))+1))GO TO 321
30200		DO 421	 KL=IFIX(PN(K)),IFIX(PN(K+1))-1
30300		LL=LL+1
30400	421	Q(LL)=Q(KL)
30500		LK=LK+1
30600		PN(LK)=LL+1
30700	321	K=K+1
30800		IF(K.LT.KK)GO TO 221
30900		L=LK-1
31000	C  L=NUMBER OF ITEMS FOR RHY RECONS.
31100	123	LB=1 
31200		LL=0
31300		R5X=0
31400	C  NEXT RECONSTITUTES RHYTHM
31500		LP=1
31600	25	N=PN(LB)
31700		R=Q(N+1)
31800		IF(TR.EQ.0)GO TO 51
31900		IF(R.EQ.1)GO TO 52
32000		IF(R.EQ.5)GO TO 52
32100		IF(R.EQ.6)GO TO 52
32200		IF(R.EQ.17)GO TO 117
32300	51	PR=0
32400		IF(R.LE.4)GO TO 430
32500		IF(R.LT.17)GO TO 30
32600	C LOOKS FOR 17 AND 18, KSIG AND METER.
32700		IF(R.GT.18)GO TO 30
32800	430	IF(R.NE.1)GO TO 230
32900		IF(Q(N).LT.7)GO TO 630
33000		IF(Q(N+9))GO TO 30
33100	C SKIPS NON-LEDGER LINE NOTES.
33200		GO TO 130
33300	630	PR=1.
33400		IF(Q(N+8).EQ.1000.)PR=.05
33500	C  ↑↑↑↑ FOR GRACE NOTES
33600		GO TO 130
33700	C  LOOK ONLY AT NOTES AND RESTS AND NON-DOUBLE STOPS, AND BARS,CLEFS
33800	230	IF(R.NE.2)GO TO 130
33900		IF(Q(N).LT.5)PR=1.
34000	C JUMP IF NO RHYTH VALUE FOUND IN P7 (P9 FOR NOTES)
34100	CC130	IF(RCLEF(Q(N)))GO TO 30
34200	CJ SKIPS NON-CLEFS
34300	130	S=Q(N+3)
34400		LA=LB
34500	26	LA=LA+1
34600		IF(LA.GT.L)GO TO 30
34700	C  FIND NEXT IMPORTANT ITEM
34800		NA=PN(LA)
34900		RR=Q(NA+1)
35000		IF(RR.LE.4)GO TO 134
35100		IF(RR.LT.17)GO TO 26
35200		IF(RR.GT.18)GO TO 26
35300	CC134	IF(RR.NE.4)GO TO 34
35400	CC	IF(Q(NA).NE.2)GO TO 26
35500	C  USES ONLY NOTES, RESTS, BARS, CLEFS
35600	CC34	IF(RCLEF(Q(NA)))GO TO 26
35700	CJ SKIPS NON-CLEFS
35800	134	RX=Q(NA+3)
35900	C  POSITION OF NEXT ITEM
36000		IF(S.EQ.RX)GO TO 26
36100		IF(R.LT.3)GO TO 235
36200		IF(R.GE.17)P=4.
36300	C  PUT IN FOR LARGE KSIGS LATER.
36400		IF(R.EQ.4)P=2.
36500		IF(R.EQ.3)P=6.
36600		IF(Q(NA+5).GE.100.)P=5.
36700	C SPACE FOR BARS, KSIG, METERS, CLEFS (LAST FOR MINI-CLEF)
36800		IF(RR.EQ.17)P=P+3.
36900	C  IF NEXT(RR) IS KSIG, ADD SPACE.
37000		GO TO 335
37100	235	K=9
37200		IF(R.EQ.2)K=7
37300		P=Q(N+K)
37400		IF(PR.NE.0)P=PR
37500	C  ASSUMES QUARTER VALUE IF NONE WAS GIVEN
37600		P=P+(.125-P)*FIB
37700	135	P=P*RSPC
37800	C  FINDS RHYTH IN P9 OR P7(REST)
37900	C  IF DIFFERENT SIMULTANEOUS RHYTHMS, ZERO OUT LARGER BEFORE HAND.
38000		IF(P)GO TO 30
38100	C  SKIPS NOTES WITH SUPPRESSED LEDGER LINES.
38200	335	SX=S+P-RX
38300		R5X=R5X+SX
38400	C  SPACE DIFFERENCE
38500	
38600		R7=RS
38700		IF(SX.LT.-.5)GO TO 29
38800		IF(SX.LT.0.5)GO TO 30
38900	2900	R4=RX
39000		R5=10000.
39100		R8=SX
39200		R9=0
39300	C  ADJUST REST OF LINE
39400		CALL PTMOVE(Q,PN)
39500		IF(SX)GO TO 30
39600	29	R4=S
39700		R5=RX
39800		R8=S
39900		R9=RX+SX
40000	C  ADJUST STUFF BETWEEN POINTS
40100		CALL PTMOVE(Q,PN)
40200		IF(SX)GO TO 2900
40300	
40400	30	LB=LB+1
40500		IF(LB.LT.L)GO TO 25
40600	C  GO BACK IF MORE SPACING TO DO
40700	C***	IF(XLFT.EQ.0)GO TO 600
40800	C  NEXT MOVES LEFT SIDE OF STAFF TO ZERO
40900	CC	R5=10000.
41000	CC	R7=RS
41100	CC	R8=-XLFT
41200	CC	R4=-101
41300	CC	R9=0
41400	CC	CALL PTMOVE(Q,PN)
41500	C***	CALL LINELN
41600	C  BREAKS IT UP INTO LINES.
41700		J=1
41800		CALL OFILE(1,'PX')
41900		LL=PN(L+1)
42000	2929	WRITE(1),L,LL,
42100		1(PN(K),K=1,L+1),(Q(K),K=1,LL-1),NAMX,STFSZ,J,J,RSTFAC,STFF,IV,STFF
42200		STOP
42300	2	FORMAT(A5)
42400	3001	FORMAT(2I6)
42500	5	FORMAT(5F)
42600	
42700	
42800	52	A=Q(N+4)
42900		Q(N+4)=A+TR
43000	C TRANSPOSES ONLY BY STAFF STEPS FOR NOW
43100		X=Q(N+5)
43200		IF(Q(N+1).EQ.1)GO TO 11
43300	C  COULD ADD STEM REVERSE HERE.
43400		Q(N+5)=X+TR
43500		GO TO 51
43600	11	A=AMOD(A,100.)
43700		IF(TR.NE.4)GO TO 1101
43800		IF(AMOD(A,7.0).EQ.0)GO TO 101
43900	1101	IF(AMOD(TR-1.0,7.0).NE.0)GO TO 51
44000	C  NEXT IS FOR Bb TRANSP.
44100		B=AMOD(A+7.0,7.0)
44200		IF(B.EQ.0)GO TO 101
44300		IF(B.NE.3)GO TO 51
44400	C  FINDS ORIG. E OR B
44500	101	M=AMOD(X,10.0)
44600	C  FINDS ACCID.
44700		X=X-M
44800	C  STEM DIR. AND DECI.
44900		B=3.
45000	C CHANGES FLAT TO NATURAL SIGN.
45100		IF(M.NE.0)GO TO 118
45200		IF(SIG.NE.200)GO TO 51
45300	C  GO BACK IF A KEY SIG. IS PRESENT
45400	118	IF(M.EQ.3)B=2
45500	C  NO PROVISION YET FOR ## OR bb
45600	2101	Q(N+5)=X+B
45700		GO TO 51
45800	117	SIG=Q(N+5)
45900		IF(TR.EQ.1)SIG=SIG+2
46000		IF(TR.EQ.4)SIG=SIG+1
46100	C CHANGE KSIG FOR Bb AND F INSTS.  ADD CHECK-UP ABOVE LATER.
46200	C  MAKES NATURALS IF CHANGED TO NO KSIG (I.E. =0)
46300		IF(SIG.NE.0)GO TO 217
46400		IF(TR.EQ.1)SIG=-102
46500		IF(TR.EQ.3)SIG=-101
46600	217	Q(N+5)=SIG
46700		GO TO 51
46800		END